home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 2.iso / dist / fw_guile.idb / usr / freeware / share / guile / 1.4 / ice-9 / streams.scm.z / streams.scm
Text File  |  2002-07-08  |  7KB  |  220 lines
  1. ;;;; streams.scm --- general lazy streams
  2. ;;;; -*- Scheme -*-
  3.  
  4. ;;;; Copyright (C) 1999 Free Software Foundation, Inc.
  5. ;;;; 
  6. ;;;; This program is free software; you can redistribute it and/or modify
  7. ;;;; it under the terms of the GNU General Public License as published by
  8. ;;;; the Free Software Foundation; either version 2, or (at your option)
  9. ;;;; any later version.
  10. ;;;; 
  11. ;;;; This program is distributed in the hope that it will be useful,
  12. ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;;;; GNU General Public License for more details.
  15. ;;;; 
  16. ;;;; You should have received a copy of the GNU General Public License
  17. ;;;; along with this software; see the file COPYING.  If not, write to
  18. ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  19. ;;;; Boston, MA 02111-1307 USA
  20.  
  21. ;; the basic stream operations are inspired by
  22. ;; (i.e. ripped off) Scheme48's `stream' package,
  23. ;; modulo stream-empty? -> stream-null? renaming.
  24.  
  25. (define-module (ice-9 streams))
  26.  
  27. (export make-stream
  28.         stream-car stream-cdr stream-null?
  29.         list->stream vector->stream port->stream
  30.         stream->list stream->reversed-list
  31.         stream->list&length stream->reversed-list&length
  32.         stream->vector
  33.         stream-fold stream-for-each stream-map)
  34.  
  35. ;; Use:
  36. ;;
  37. ;; (make-stream producer initial-state)
  38. ;;  - PRODUCER is a function of one argument, the current state.
  39. ;;    it should return either a pair or an atom (i.e. anything that
  40. ;;    is not a pair).  if PRODUCER returns a pair, then the car of the pair
  41. ;;    is the stream's head value, and the cdr is the state to be fed
  42. ;;    to PRODUCER later.  if PRODUCER returns an atom, then the stream is
  43. ;;    considered depleted.
  44. ;;
  45. ;; (stream-car stream)
  46. ;; (stream-cdr stream)
  47. ;; (stream-null? stream)
  48. ;;  - yes.
  49. ;;
  50. ;; (list->stream list)
  51. ;; (vector->stream vector)
  52. ;;  - make a stream with the same contents as LIST/VECTOR.
  53. ;;
  54. ;; (port->stream port read)
  55. ;;  - makes a stream of values which are obtained by READing from PORT.
  56. ;;
  57. ;; (stream->list stream)
  58. ;;  - returns a list with the same contents as STREAM.
  59. ;;
  60. ;; (stream->reversed-list stream)
  61. ;;  - as above, except the contents are in reversed order.
  62. ;;
  63. ;; (stream->list&length stream)
  64. ;; (stream->reversed-list&length stream)
  65. ;;  - multiple-valued versions of the above two, the second value is the
  66. ;;    length of the resulting list (so you get it for free).
  67. ;;
  68. ;; (stream->vector stream)
  69. ;;  - yes.
  70. ;;
  71. ;; (stream-fold proc init stream0 ...)
  72. ;;  - PROC must take (+ 1 <number-of-stream-arguments>) arguments, like this:
  73. ;;    (PROC car0 ... init).  *NOTE*: the INIT argument is last, not first.
  74. ;;    I don't have any preference either way, but it's consistent with
  75. ;;    `fold[lr]' procedures from SRFI-1.  PROC is applied to successive
  76. ;;    elements of the given STREAM(s) and to the value of the previous
  77. ;;    invocation (INIT on the first invocation).  the last result from PROC
  78. ;;    is returned.
  79. ;;
  80. ;; (stream-for-each proc stream0 ...)
  81. ;;  - like `for-each' we all know and love.
  82. ;;
  83. ;; (stream-map proc stream0 ...)
  84. ;;  - like `map', except returns a stream of results, and not a list.
  85.  
  86. ;; Code:
  87.  
  88. (define (make-stream m state)
  89.   (delay
  90.     (let ((o (m state)))
  91.       (if (pair? o)
  92.       (cons (car o)
  93.         (make-stream m (cdr o)))
  94.           '()))))
  95.  
  96. (define (stream-car stream)
  97.   "Returns the first element in STREAM.  This is equivalent to `car'."
  98.   (car (force stream)))
  99.  
  100. (define (stream-cdr stream)
  101.   "Returns the first tail of STREAM. Equivalent to `(force (cdr STREAM))'."
  102.   (cdr (force stream)))
  103.  
  104. (define (stream-null? stream)
  105.   "Returns `#t' if STREAM is the end-of-stream marker; otherwise
  106. returns `#f'.  This is equivalent to `null?', but should be used
  107. whenever testing for the end of a stream."
  108.   (null? (force stream)))
  109.  
  110. (define (list->stream l)
  111.   "Returns a newly allocated stream whose elements are the elements of
  112. LIST.  Equivalent to `(apply stream LIST)'."
  113.   (make-stream
  114.    (lambda (l) l)
  115.    l))
  116.  
  117. (define (vector->stream v)
  118.   (make-stream
  119.    (let ((len (vector-length v)))
  120.      (lambda (i)
  121.        (or (= i len)
  122.            (cons (vector-ref v i) (+ 1 i)))))
  123.    0))
  124.  
  125. (define (stream->reversed-list&length stream)
  126.   (let loop ((s stream) (acc '()) (len 0))
  127.     (if (stream-null? s)
  128.         (values acc len)
  129.         (loop (stream-cdr s) (cons (stream-car s) acc) (+ 1 len)))))
  130.  
  131. (define (stream->reversed-list stream)
  132.   (call-with-values
  133.    (lambda () (stream->reversed-list&length stream))
  134.    (lambda (l len) l)))
  135.  
  136. (define (stream->list&length stream)
  137.   (call-with-values
  138.    (lambda () (stream->reversed-list&length stream))
  139.    (lambda (l len) (values (reverse! l) len))))
  140.  
  141. (define (stream->list stream)
  142.   "Returns a newly allocated list whose elements are the elements of STREAM.
  143. If STREAM has infinite length this procedure will not terminate."
  144.   (reverse! (stream->reversed-list stream)))
  145.  
  146. (define (stream->vector stream)
  147.   (call-with-values
  148.    (lambda () (stream->reversed-list&length stream))
  149.    (lambda (l len)
  150.      (let ((v (make-vector len)))
  151.        (let loop ((i 0) (l l))
  152.          (if (not (null? l))
  153.              (begin
  154.                (vector-set! v (- len i 1) (car l))
  155.                (loop (+ 1 i) (cdr l)))))
  156.        v))))
  157.  
  158. (define (stream-fold f init stream . rest)
  159.   (if (null? rest) ;fast path
  160.       (stream-fold-one f init stream)
  161.       (stream-fold-many f init (cons stream rest))))
  162.  
  163. (define (stream-fold-one f r stream)
  164.   (if (stream-null? stream)
  165.       r
  166.       (stream-fold-one f (f (stream-car stream) r) (stream-cdr stream))))
  167.  
  168. (define (stream-fold-many f r streams)
  169.   (if (or-map stream-null? streams)
  170.       r
  171.       (stream-fold-many f
  172.                         (apply f (let recur ((cars
  173.                                               (map stream-car streams)))
  174.                                    (if (null? cars)
  175.                                        (list r)
  176.                                        (cons (car cars)
  177.                                              (recur (cdr cars))))))
  178.                         (map stream-cdr streams))))
  179.  
  180. (define (stream-for-each f stream . rest)
  181.   (if (null? rest) ;fast path
  182.       (stream-for-each-one f stream)
  183.       (stream-for-each-many f (cons stream rest))))
  184.  
  185. (define (stream-for-each-one f stream)
  186.   (if (not (stream-null? stream))
  187.       (begin
  188.         (f (stream-car stream))
  189.         (stream-for-each-one f (stream-cdr stream)))))
  190.  
  191. (define (stream-for-each-may f streams)
  192.   (if (not (or-map stream-null? streams))
  193.       (begin
  194.         (apply f (map stream-car streams))
  195.         (stream-for-each-one f (map stream-cdr streams)))))
  196.  
  197. (define (stream-map f stream . rest)
  198.   "Returns a newly allocated stream, each element being the result of
  199. invoking F with the corresponding elements of the STREAMs
  200. as its arguments."
  201.   (if (null? rest) ;fast path
  202.       (make-stream (lambda (s)
  203.                      (or (stream-null? s)
  204.                          (cons (f (stream-car s)) (stream-cdr s))))
  205.                    stream)
  206.       (make-stream (lambda (streams)
  207.                      (or (or-map stream-null? streams)
  208.                          (cons (apply f (map stream-car streams))
  209.                                (map stream-cdr streams))))
  210.                    (cons stream rest))))
  211.  
  212. (define (port->stream port read)
  213.   (make-stream (lambda (p)
  214.                  (let ((o (read p)))
  215.                    (or (eof-object? o)
  216.                        (cons o p))))
  217.                port))
  218.  
  219. ;;; streams.scm ends here
  220.